home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / TOSDEBUG.I < prev    next >
Encoding:
Modula Implementation  |  1991-07-29  |  10.6 KB  |  400 lines
  1. IMPLEMENTATION MODULE TOSDebug; (* V#054, Stand: 29.7.91 *)
  2. (*$B+,R-,F-*)
  3.  
  4. (*
  5.  * Version für MOS 1.x erstellt Mai '87 von Thomas Tempelmann
  6.  * Version für MOS 2.x erstellt März '90 von Thomas Tempelmann
  7.  *)
  8.  
  9. (*
  10.  *   T O S - V e r s i o n
  11.  *  =======================
  12.  *
  13.  * Gibt Modula-Zeilen aus, die erzeugt werden, wenn im Quelltext die
  14.  * Compiler-Option "(*$D+*)" verwendet wird.
  15.  *
  16.  * Eine "Debug"-Ausgabeanweisung, die der Compiler erzeugt, hat folg. Format:
  17.  *
  18.  *   ... normaler Maschinencode ...
  19.  *   TRAP #5       -  Assembler-Anweisung, löst TRAP-5 Exception aus.
  20.  *   DC.W cmd      -  Kennung, die bestimmt, ob Zeile oder eine Zahl angezeigt
  21.  *                    werden soll (siehe unten, Funktion 'dispLine').
  22.  * [ ASC  '...' ]  -  Modula-Text, falls eine Zeile angezeigt werden soll;
  23.  *                    sonst steht die bestimmte Zahl auf dem Parameterstack.
  24.  *)
  25.  
  26. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE, WORD, LONGWORD;
  27.  
  28. FROM Excepts IMPORT InstallPreExc;
  29.  
  30. FROM PrgCtrl IMPORT TermProcess, CatchProcessTerm, TermCarrier;
  31.  
  32. FROM Strings IMPORT Empty, Length;
  33.  
  34. FROM MOSGlobals IMPORT UserBreak, MemArea;
  35.  
  36. FROM SysTypes IMPORT ExcSet, TRAP5, ExcDesc;
  37.  
  38. FROM Terminal IMPORT Read, Write, WriteLn, CondRead, WriteString,
  39.         FlushKbd, ReadString;
  40.  
  41. FROM ModCtrl IMPORT GetModName;
  42.  
  43. FROM SysUtil1 IMPORT Peek;
  44.  
  45. IMPORT StrConv;
  46.  
  47. IMPORT SYSTEM, FPUSupport;
  48.  
  49.  
  50. TYPE Mode = (m2Line, asmLine, procEntry, procExit);
  51.  
  52. VAR WaitNext, WaitKey: BOOLEAN;
  53.  
  54.  
  55. PROCEDURE WriteLHex (v:LONGWORD);
  56.   BEGIN
  57.     WriteString (StrConv.LHexToStr (v,9))
  58.   END WriteLHex;
  59.  
  60. PROCEDURE dispRegs (VAR info: ExcDesc);
  61.   BEGIN
  62.     WriteLn;
  63.     WITH info DO
  64.       WriteString ('D0:');  WriteLHex (regD0);
  65.       WriteString (' D1:'); WriteLHex (regD1);
  66.       WriteString (' D2:'); WriteLHex (regD2);
  67.       WriteString (' D3:'); WriteLHex (regD3);
  68.       WriteLn;
  69.       WriteString ('D4:');  WriteLHex (regD4);
  70.       WriteString (' D5:'); WriteLHex (regD5);
  71.       WriteString (' D6:'); WriteLHex (regD6);
  72.       WriteString (' D7:'); WriteLHex (regD7);
  73.       WriteLn;
  74.       WriteString ('A0:');  WriteLHex (regA0);
  75.       WriteString (' A1:'); WriteLHex (regA1);
  76.       WriteString (' A2:'); WriteLHex (regA2);
  77.       WriteString (' A3:'); WriteLHex (regA3);
  78.       WriteLn;
  79.       WriteString ('A4:');  WriteLHex (regA4);
  80.       WriteString (' A5:'); WriteLHex (regA5);
  81.       WriteString (' A6:'); WriteLHex (regA6);
  82.       WriteString (' A7:'); WriteLHex (regUSP);
  83.     END
  84.   END dispRegs;
  85.  
  86.  
  87.  
  88. PROCEDURE dispLine (mode: Mode; VAR info: ExcDesc);
  89.   
  90.   VAR buffered: BOOLEAN; bufCh: CHAR;
  91.   
  92.   PROCEDURE KeyPress (): BOOLEAN;
  93.     BEGIN
  94.       CondRead (bufCh,buffered);
  95.       RETURN buffered
  96.     END KeyPress;
  97.   
  98.   PROCEDURE GetKey (VAR ch: CHAR);
  99.     BEGIN
  100.       IF buffered THEN
  101.         buffered:= FALSE;
  102.         ch:= bufCh
  103.       ELSE
  104.         Read (ch)
  105.       END
  106.     END GetKey;
  107.   
  108.   VAR ch:CHAR; s:ARRAY [0..9] OF CHAR; p:CARDINAL; done,ok:BOOLEAN;
  109.       ps: POINTER TO ARRAY [0..160] OF CHAR;
  110.       proc,name: ARRAY [0..39] OF CHAR; rel: LONGCARD;
  111.   
  112.   BEGIN (* dispLine *)
  113.     IF WaitKey THEN
  114.       buffered:= FALSE;
  115.       IF ~Continuous OR KeyPress() THEN
  116.         REPEAT
  117.           GetKey (ch);
  118.           ok:= TRUE;
  119.           CASE CAP (ch) OF
  120.             15C: Continuous:= TRUE|                             (* RETURN *)
  121.             ' ': Continuous:= FALSE|                            (* SPACE *)
  122.             3C : TermProcess (UserBreak)|                       (* CTRL-C *)
  123.             'A': Step:= 0L; Active:= TRUE; Continuous:= FALSE|
  124.             'S': WriteString ('Step? '); ReadString (s); p:=0;
  125.                  Step:= StrConv.StrToLCard (s,p,done);
  126.                  IF done THEN
  127.                    Active:= FALSE; Continuous:= TRUE;
  128.                  END|
  129.             'L': LineAddr:= ~LineAddr; ok:= FALSE|
  130.             'H': Hex:= TRUE; ok:= FALSE|
  131.             'D': Hex:= FALSE; ok:= FALSE|
  132.             'R': dispRegs (info); ok:= FALSE|
  133.           ELSE
  134.             ok:= FALSE
  135.           END
  136.         UNTIL ok
  137.       END
  138.     END;
  139.     
  140.     IF WaitNext THEN FlushKbd; WaitKey:= TRUE; WaitNext:= FALSE END;
  141.     
  142.     IF Active THEN Step:= 0L END;
  143.     
  144.     IF Step # 0L THEN
  145.       DEC (Step);
  146.       IF Step = 0L THEN Active:= TRUE; Continuous:= FALSE END;
  147.     END;
  148.     
  149.     ps:= info.regPC;                    (* PC hinter Zeilentext setzen *)
  150.     INC (info.regPC,Length (ps^)+1);
  151.     IF ODD (info.regPC) THEN INC (info.regPC) END;
  152.     
  153.     IF Active THEN                      (* Zeile anzeigen *)
  154.       WriteLn;
  155.       IF (mode = m2Line) OR (mode = asmLine) THEN
  156.         IF LineAddr THEN
  157.           WriteLHex (info.regPC);
  158.           WriteString (': ');
  159.           GetModName (info.regPC,name,rel,proc);
  160.           WriteString (name);
  161.           WriteString (' / ');
  162.           IF ~Empty (proc) THEN
  163.             WriteString (proc)
  164.           ELSE
  165.             WriteString (StrConv.LHexToStr (rel,5))
  166.           END;
  167.           WriteLn;
  168.         END;
  169.         IF ps^[0]=12C (* LF *) THEN INC (ps) END;
  170.         WriteString (ps^);
  171.         WriteLn;
  172.       ELSE
  173.         IF mode = procEntry THEN
  174.           WriteString ('Enter ')
  175.         ELSE
  176.           WriteString ('                                   Exit ')
  177.         END;
  178.         WriteString (ps^);
  179.       END;
  180.     END;
  181.   END dispLine;
  182.  
  183.  
  184. MODULE RealSupport;
  185.  
  186.   FROM SYSTEM IMPORT LONGWORD, ASSEMBLER;
  187.   FROM FPUSupport IMPORT NewContext, SaveContext, RestoreContext, FPUContext;
  188.  
  189.   EXPORT SaveTempRealRegs, RestoreTempRealRegs;
  190.  
  191.   TYPE TempRealRegBuffer = ARRAY [1..6] OF LONGWORD;
  192.  
  193.   VAR buffer: TempRealRegBuffer;
  194.   VAR fpu: FPUContext;
  195.  
  196.   PROCEDURE SaveTempRealRegs ();
  197.     BEGIN
  198.       ASSEMBLER
  199.         ; die ersten 3 Pseudo-Regs aus dem Modul Runtime
  200.         LEA buffer,A1
  201.         LEA @FP0L,A0 MOVEQ #5,D0 l1 MOVE.L (A0)+,(A1)+ DBRA D0,l1
  202.       END;
  203.       SaveContext (fpu);
  204.     END SaveTempRealRegs;
  205.  
  206.   PROCEDURE RestoreTempRealRegs ();
  207.     BEGIN
  208.       ASSEMBLER
  209.         LEA buffer,A1
  210.         LEA @FP0L,A0 MOVEQ #5,D0 l1 MOVE.L (A1)+,(A0)+ DBRA D0,l1
  211.       END;
  212.       RestoreContext (fpu);
  213.     END RestoreTempRealRegs;
  214.  
  215.   BEGIN
  216.     NewContext (fpu)
  217.   END (* MODULE *) RealSupport;
  218.  
  219.  
  220. PROCEDURE HdlExc ( VAR info: ExcDesc ): BOOLEAN;
  221.  
  222.   PROCEDURE loadValue (VAR v: ARRAY OF BYTE);
  223.     (* holt Wert vom A3-Stack und korrigiert A3 dabei auch *)
  224.     VAR n: CARDINAL;
  225.     BEGIN
  226.       n:= HIGH (v);
  227.       IF n = 0 THEN INC (n) END;
  228.       DEC (info.regA3.p, n+1);
  229.       Peek (info.regA3.p, v);
  230.     END loadValue;
  231.  
  232.   PROCEDURE dispNum (size: CARDINAL; signed: BOOLEAN);
  233.     VAR by: BYTE; wd: WORD; lw: LONGWORD;
  234.     BEGIN
  235.       IF size = 4 THEN
  236.         loadValue (lw);
  237.       ELSE
  238.         IF size = 2 THEN
  239.           loadValue (wd);
  240.         ELSE
  241.           loadValue (by);
  242.           IF signed THEN
  243.             wd:= WORD (INT (by))
  244.           ELSE
  245.             wd:= WORD (ORD (by))
  246.           END
  247.         END;
  248.         IF signed THEN
  249.           lw:= LONGWORD (LONG (INTEGER (wd)))
  250.         ELSE
  251.           lw:= LONGWORD (LONG (CARDINAL (wd)))
  252.         END
  253.       END;
  254.       IF Active THEN
  255.         IF Hex THEN
  256.           WriteString (StrConv.LHexToStr (lw,0))
  257.         ELSIF signed THEN
  258.           WriteString (StrConv.IntToStr (LONGINT (lw),0));
  259.         ELSE
  260.           WriteString (StrConv.CardToStr (LONGCARD (lw),0));
  261.         END
  262.       END;
  263.     END dispNum;
  264.  
  265.   PROCEDURE dispChar ();
  266.     VAR ch: CHAR;
  267.     BEGIN
  268.       loadValue (ch);
  269.       IF Active THEN
  270.         IF ch < ' ' THEN        (* Steuerzeichen als Oktalkonstante anzeigen *)
  271.           WriteString (StrConv.NumToStr (ORD (ch),8,0,' '));
  272.           Write ('C')
  273.         ELSE
  274.           Write ("'");
  275.           Write (ch);
  276.           Write ("'");
  277.         END
  278.       END;
  279.     END dispChar;
  280.  
  281.   PROCEDURE dispReal (long: BOOLEAN);
  282.     VAR sr: REAL; lr: LONGREAL;
  283.     BEGIN
  284.       IF long THEN
  285.         loadValue (lr)
  286.       ELSE
  287.         loadValue (sr);
  288.         lr:= LONG (sr)
  289.       END;
  290.       IF Active THEN
  291.         SaveTempRealRegs;
  292.         WriteString (StrConv.RealToStr (lr,0,6));
  293.         RestoreTempRealRegs;
  294.       END;
  295.     END dispReal;
  296.  
  297.   PROCEDURE dispBool ();
  298.     VAR b: BOOLEAN;
  299.     BEGIN
  300.       loadValue (b);
  301.       IF Active THEN
  302.         IF b THEN
  303.           WriteString ('TRUE ')
  304.         ELSE
  305.           WriteString ('FALSE')
  306.         END
  307.       END;
  308.     END dispBool;
  309.  
  310.   PROCEDURE dispString ();
  311.     (* Für Strings werden Adresse und HIGH-Wert auf dem A3-Stack abgelegt *)
  312.     VAR high: CARDINAL; ptr: POINTER TO CHAR;
  313.     BEGIN
  314.       loadValue (high);
  315.       loadValue (ptr);
  316.       IF Active THEN
  317.         Write ('"');
  318.         LOOP
  319.           IF ptr^ = 0C THEN EXIT END;
  320.           Write (ptr^);
  321.           INC (ptr);
  322.           IF high = 0 THEN EXIT END;
  323.           DEC (high)
  324.         END;
  325.         Write ('"')
  326.       END;
  327.     END dispString;
  328.  
  329.   VAR no:CARDINAL; old: BOOLEAN;
  330.  
  331.   BEGIN
  332.     no:= CARDINAL (info.regPC^);
  333.     INC (info.regPC,2);
  334.     CASE no OF
  335.       0 : dispLine (m2Line, info)|
  336.       64: dispLine (asmLine, info)|
  337.       66: dispLine (procEntry, info)|
  338.       67: dispLine (procExit, info)|
  339.     ELSE
  340.       CASE no OF
  341.             1,4: dispNum (4, TRUE)|
  342.               2: dispReal (TRUE)|
  343.              40: dispReal (FALSE)|
  344.               3: dispChar ()|
  345.         35,34,9: dispNum (2, FALSE)|
  346.   8,20,23,25,26: old:= Hex; Hex:= TRUE; dispNum (4, FALSE); Hex:= old|
  347.           21,41: old:= Hex; Hex:= TRUE; dispNum (2, FALSE); Hex:= old|
  348.           30,22: dispNum (4, FALSE)|
  349.              24: dispBool ()|
  350.              27: dispString ()|
  351.              33: dispNum (2, TRUE)|
  352.           38,39: old:= Hex; Hex:= TRUE; dispNum (1, FALSE); Hex:= old|
  353.       ELSE
  354.           (* Tja - da haben wir einen Code nicht ausgewertet! *)
  355.           WriteLn;
  356.           WriteLn;
  357.           WriteString ('*** Fehler in Debug-Modul - unbekannter Code:');
  358.           WriteLn;
  359.           WriteString (StrConv.CardToStr (no,0));
  360.           HALT
  361.       END;
  362.       IF Active THEN
  363.         WriteString ('   ')
  364.       END
  365.     END;
  366.     RETURN FALSE
  367.   END HdlExc;
  368.  
  369.  
  370. VAR stk: ARRAY [1..2000] OF WORD;
  371.     wsp: MemArea;
  372.     hdl: ADDRESS;
  373.     tHdl: TermCarrier;
  374.  
  375. PROCEDURE Terminate;
  376.   VAR ch:CHAR;
  377.   BEGIN
  378.     WriteLn;
  379.     WriteString ('Programmende: Bitte Taste...');
  380.     Read (ch)
  381.   END Terminate;
  382.  
  383. BEGIN
  384.   Active:= TRUE;
  385.   Step:= 0L;
  386.   Continuous:= FALSE;
  387.   Hex := FALSE;
  388.   LineAddr:= FALSE;
  389.   
  390.   (* damit erste Zeile sofort erscheint: *)
  391.   WaitKey:= FALSE;
  392.   WaitNext:= TRUE;
  393.   
  394.   wsp.bottom:= ADR (stk);
  395.   wsp.length:= SIZE (stk);
  396.   InstallPreExc (ExcSet{TRAP5}, HdlExc, TRUE, wsp, hdl);
  397.   IF hdl=NIL THEN HALT END;
  398.   CatchProcessTerm (tHdl,Terminate,wsp);
  399. END TOSDebug.
  400.